perm filename DICT[DEN,LMM] blob
sn#070833 filedate 1973-11-07 generic text, type T, neo UTF8
(FILECREATED " 7-NOV-73 5:23:59" S-DICT)
(LISPXPRINT (QUOTE DICTVARS)
T)
[RPAQQ DICTVARS
((* Dictionary creation - Really needs work to make sure
interfaces with advising, breaking, etc will all work)
(FNS ENTER LOOKUP MAKTAB WRITESOME PUSHCAR WRITEALL
WRITEDICT WRITESOME1)
(VARS (DICTIONARYLST)
(CHANGEDICTLST))
(ADDVARS (PRETTYTYPELST (CHANGEDICTLST NIL "dictionaries")))
(P (ADVISE (QUOTE CLEANUP)
(QUOTE BEFORE)
(QUOTE (WRITEDICT)))
(SETQ ADVISEDFNS (/DREMOVE (QUOTE CLEANUP)
ADVISEDFNS)))
(BLOCKS (DICTBLOCK ENTER LOOKUP MAKTAB WRITESOME PUSHCAR
WRITEALL WRITEDICT WRITESOME1
(ENTRIES ENTER LOOKUP MAKTAB WRITEALL
WRITEDICT)
(GLOBALVARS DICTIONARYLST CHANGEDICTLST)
(LOCALFREEVARS DICT]
(* Dictionary creation - Really needs work to make sure interfaces
with advising, breaking, etc will all work)
(DEFINEQ
(ENTER
[LAMBDA (PTR DICT VAL)
(* ENTER value into dictionary -
VAL is the value, PTR is the return from LOOKUP
(which should be (LIST ARGS)) and DICT is the
dictionary in which PTR is contained
(needed to get the file name, and the number in
core verses the max in core allowed))
(OR (LISTP DICT)
(ERROR "BAD DICTIONARY" "GIVEN TO ENTER"))
(FRPLACA (CDR DICT)
(ADD1 (CADR DICT))) (* Bump the incore
counter)
(FRPLACD PTR (CONS NIL VAL))
(FRPLACA (QUOTE CHANGEDICTLST)
DICTIONARYLST)
(WRITESOME DICT)
VAL])
(LOOKUP
[LAMBDA (INDEX DICT NOENTER)
(* Lookup INDEX on the dictionary DICT -
Unless NOENTER is on, insert empty marker and
return it if INDEX isn't found)
(OR (LISTP DICT)
(ERROR "LOOKUP GIVEN" "EMPTY DICTIONARY"))
(PROG ((FND (SASSOC INDEX (CDDDR DICT)))
FIL) (* Use SACCOC to find
entry, if any)
(COND
((NOT FND)
(AND NOENTER (RETURN)) (* If no entry, just
insert empty entry in
the dictionary and
return)
(SETQ FND (LIST INDEX))
(FRPLACD (CDDR DICT)
(CONS FND (CDDDR DICT)))
(RETURN FND)))
[PUSHCAR (CDDR DICT)
(NLEFT (CDDR DICT)
1
(FMEMB FND (CDDDR DICT]
(* Move the found
entry to the front of
the dictionary)
(COND
((NULL (CDR FND))
(* If no file pointer, then this was an empty
entry (only possible for an aborted computation))
(RETURN FND))
((NULL (CDDR FND))
(COND
((NULL (CADR FND))
(* No value, no ptr, but a ptr place -- this is a
funny situation again, but might happen if abort
occurs)
(FRPLACD FND NIL)
(RETURN FND)))
(* Read in from file, bump incore counter, and
check if too many incore, writing outsome;
then return the value)
(SFPTR [SETQ FIL (OR (OPENP (CAR DICT))
(IOFILE (CAR DICT]
(CADR FND))
(FRPLACD (CDR FND)
(READ FIL))
(FRPLACA (CDR DICT)
(ADD1 (CADR DICT)))
(WRITESOME DICT) (* Check if need to
bump some out)
(RETURN FND))
(T (* It's already in
core)
(RETURN FND])
(MAKTAB
[LAMBDA (FN MAXCORE FILE)
(* Fix up FN so that it uses a dictionary called
FILE (which is also the file name that it uses) -
If FILE is NIL, use the FN name -
MAXCORE is the maximum number of dictionary
entries that can reside in core -
If FN is NIL, just create the dictionary, but
don't ADVISE any function)
(PROG (VARS TEM)
(OR FN FILE (ERROR "NO NAME FOR THIS" "DICTIONARY"))
(SETQ TEM (NAMEFIELD (OR FN FILE)))
[OR FILE (SETQ FILE (PACK (LIST TEM (QUOTE ".DICT"]
(COND
((MEMB FILE DICTIONARYLST)
(ERROR FILE "ALREADY IS A DICTIONARY")))
(COND
(FN [COND
((CDR (SETQ VARS (ARGLIST FN)))
(SETQ VARS (CONS (QUOTE LIST)
VARS)))
(T (SETQ VARS (CAR VARS]
(* VARS will be the expression that is to be
looked up -
Usually (LIST <ARGLIST FN>) but if there is only
one ARG to FN, will use it alone)
(VIRGINFN FN T)
(* The function will look like -
(tem← (LOOKUP <ARGS> <DICT>))
(if (CDR TEM) then (RETURN
(CDDR TEM)) else <compute function>
(ENTER TEM FN !VALUE)))
[ADVISE FN (QUOTE BIND)
(LIST (LIST (QUOTE TEM)
(LIST (QUOTE LOOKUP)
VARS FILE]
[ADVISE FN (QUOTE BEFORE)
(QUOTE (COND
((CDR TEM)
(RETURN (CDDR TEM]
[ADVISE FN (QUOTE AFTER)
(LIST (QUOTE COND)
(LIST (QUOTE (NULL (CDR TEM)))
(LIST (QUOTE ENTER)
(QUOTE TEM)
FILE
(QUOTE !VALUE]
(/PUT FN (QUOTE DICTIONARY)
FILE))) (* Open FILE, and set
up incore dictionary)
[/SET FILE (COND
([INFILEP (SETQ TEM (PACK (LIST TEM ".INDEX"]
(READFILE TEM))
(T (LIST (IOFILE (OR (INFILEP FILE)
(OUTFILEP FILE)))
0
(OR MAXCORE 10]
(/PUT FILE (QUOTE INDEX)
TEM)
(/RPLACA (QUOTE DICTIONARYLST)
(CONS FILE DICTIONARYLST])
(WRITESOME
[LAMBDA (DICT CNT)
(* If the number of incore entries exceeds the max
incore entries, look for the first incore entry
that is followed by one not in core -
Delete the incore value (writing it out if it's
not already on file), and decrement the incore
counter)
(AND [NOT (ILESSP (CADR DICT)
(OR CNT (CADDR DICT]
(WRITESOME1 (CDDDR DICT))
(FRPLACA (CDR DICT)
(SUB1 (CADR DICT])
(PUSHCAR
[LAMBDA (L1 L2)
(* PUSH (CADR L2) after (CAR L1) -
L2 is a tail of L1 -
Sort of complicated)
(OR (EQ L1 L2)
(PROG (TEM)
(SETQ TEM (CDR L1))
(FRPLACD L1 (CDR L2))
(FRPLACD L2 (CDDR L2))
(FRPLACD (CDR L1)
TEM])
(WRITEALL
[LAMBDA (DICT)
(WHILE (WRITESOME DICT 0) DO NIL])
(WRITEDICT
[LAMBDA (FILE)
(COND
[(NULL FILE)
(COND
((AND CHANGEDICTLST DICTIONARYLST)
(LISPXPRIN1 "writing dictionaries:
" T)
[MAPC DICTIONARYLST (FUNCTION (LAMBDA (FILE)
(LISPXPRINT (WRITEDICT FILE)
T]
(SETQ CHANGEDICTLST]
((MEMB FILE DICTIONARYLST)
(WRITEALL (CAR FILE))
[WRITEFILE (CAR FILE)
(OR (GETP FILE (QUOTE INDEX))
(PACK (LIST (NAMEFIELD FILE)
(QUOTE .INDEX]
FILE)
[(PROG [(TEM (GETP FILE (QUOTE DICTIONARY]
(COND
(TEM (WRITEDICT TEM]
(T (ERROR FILE "is not a dictionary"])
(WRITESOME1
[LAMBDA (DICTL)
(* Tries to write out the last possible DICT
element -
Should be the one referenced least recently)
(COND
((NULL DICTL) (* End of list, back
up)
NIL)
((WRITESOME1 (CDR DICTL)) (* First try on CDR,
if sucessful, return)
T)
((CDDR (CAR DICTL)) (* This is the last
entry that has a value
in it)
[COND
((NULL (CADAR DICTL))
(* If it hasn't been written out on a file, the
ptr field will be NIL)
(PROG (POS (FIL (CAR DICT))) (* Get the file name
from DICT)
(SFPTR (SETQ FIL (OR (OPENP FIL (QUOTE OUTPUT))
(IOFILE FIL)))
-1) (* Set file pointer to
end of file)
(SETQ POS (SFPTR FIL))
(* And save the pointer so that it can be entered
into the DICT)
(PRINT (CDDR (CAR DICTL))
FIL) (* Write out value on
the file)
(FRPLACA (CDAR DICTL)
POS) (* Insert file pointer
in dictionary)
]
(FRPLACD (CDR (CAR DICTL))
NIL])
)
(RPAQ DICTIONARYLST)
(RPAQ CHANGEDICTLST)
(ADDTOVAR PRETTYTYPELST (CHANGEDICTLST NIL "dictionaries"))
(ADVISE (QUOTE CLEANUP)
(QUOTE BEFORE)
(QUOTE (WRITEDICT)))
(SETQ ADVISEDFNS (/DREMOVE (QUOTE CLEANUP)
ADVISEDFNS))
(DECLARE
(BLOCK: DICTBLOCK ENTER LOOKUP MAKTAB WRITESOME PUSHCAR WRITEALL
WRITEDICT WRITESOME1 (ENTRIES ENTER LOOKUP MAKTAB WRITEALL
WRITEDICT)
(GLOBALVARS DICTIONARYLST CHANGEDICTLST)
(LOCALFREEVARS DICT))
)STOP